home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr05 / mswlogo3.zip / MSWLOGO.ZIP / EXAMPLES.ZIP / COMPILE < prev    next >
Text File  |  1993-04-12  |  4KB  |  142 lines
  1. ;
  2. ; Function:
  3. ;
  4. ; PreCompiler for functions with MAP and REDUCE like functions
  5. ;
  6. ; Load "compile
  7. ; Call COMPILE "mylogoroutine
  8. ;
  9. TO COMPILE :PROCS
  10. IF WORDP :PROCS [COMPILE1 :PROCS STOP]
  11. IF EMPTYP :PROCS [STOP]
  12. COMPILE1 FIRST :PROCS
  13. COMPILE BF :PROCS
  14. END
  15.  
  16. TO COMPILE.FILTER :TEMPLATE :LIST
  17. LOCAL [GENPROC GENINPUT]
  18. MAKE "GENPROC GENSYM
  19. MAKE "GENINPUT GENSYM
  20. DEFINE :GENPROC (LIST ~
  21.     (LIST :GENINPUT) ~
  22.     (SE [IF EMPTYP] DOTS :GENINPUT (LIST (LIST "OUTPUT DOTS :GENINPUT))) ~
  23.     (SE [IF (] COMPILE.TEMPLATE :GENINPUT :TEMPLATE [)] ~
  24.         (LIST (SE [OUTPUT COMBINE ( FIRST] DOTS :GENINPUT [)] ~
  25.               [(] :GENPROC "BF DOTS :GENINPUT [)] ))) ~
  26.     (SE "OUTPUT :GENPROC "BF DOTS :GENINPUT))
  27. OUTPUT FPUT :GENPROC :LIST
  28. END
  29.  
  30. TO COMPILE.FOREACH :TEMPLATE :LIST
  31. LOCAL [GENPROC GENINPUT]
  32. MAKE "GENPROC GENSYM
  33. MAKE "GENINPUT GENSYM
  34. DEFINE :GENPROC (LIST ~
  35.     (LIST :GENINPUT) ~
  36.     (SE [IF EMPTYP] DOTS :GENINPUT [[STOP]]) ~
  37.     (COMPILE.TEMPLATE :GENINPUT :TEMPLATE) ~
  38.     (SE :GENPROC "BF DOTS :GENINPUT))
  39. OUTPUT FPUT :GENPROC :LIST
  40. END
  41.  
  42. TO COMPILE.LINE :LINE
  43. IF EMPTYP :LINE [OUTPUT []]
  44. IF LISTP FIRST :LINE ~
  45.    [OUTPUT FPUT (COMPILE.LINE FIRST :LINE) (COMPILE.LINE BF :LINE)]
  46. IF MEMBERP FIRST :LINE [FOREACH MAP REDUCE FILTER] ~
  47.    [OUTPUT SE (COMPILE.SPECIAL TOCLOSE :LINE) ~
  48.               (COMPILE.LINE FROMCLOSE :LINE)]
  49. OUTPUT FPUT (FIRST :LINE) (COMPILE.LINE BF :LINE)
  50. END
  51.  
  52. TO COMPILE.MAP :TEMPLATE :LIST
  53. LOCAL [GENPROC GENINPUT]
  54. MAKE "GENPROC GENSYM
  55. MAKE "GENINPUT GENSYM
  56. DEFINE :GENPROC (LIST ~
  57.     (LIST :GENINPUT) ~
  58.     (SE [IF EMPTYP] DOTS :GENINPUT (LIST (LIST "OUTPUT DOTS :GENINPUT))) ~
  59.     (SE [OUTPUT COMBINE (] COMPILE.TEMPLATE :GENINPUT :TEMPLATE [)] ~
  60.         [(] :GENPROC "BF DOTS :GENINPUT [)] ))
  61. OUTPUT FPUT :GENPROC :LIST
  62. END
  63.  
  64. TO COMPILE.REDUCE :FUNCTION :LIST
  65. LOCAL [GENPROC GENINPUT]
  66. MAKE "GENPROC GENSYM
  67. MAKE "GENINPUT GENSYM
  68. DEFINE :GENPROC (LIST ~
  69.     (LIST :GENINPUT) ~
  70.     (SE [IF EMPTYP BF] DOTS :GENINPUT ~
  71.         (LIST (SE [OUTPUT FIRST] DOTS :GENINPUT))) ~
  72.     (SE "OUTPUT :FUNCTION [( FIRST] DOTS :GENINPUT [)] ~
  73.         [(] :GENPROC "BF DOTS :GENINPUT [)] ))
  74. OUTPUT FPUT :GENPROC :LIST
  75. END
  76.  
  77. TO COMPILE.SPECIAL :EXPR
  78. IF EQUALP FIRST :EXPR "FOREACH ~
  79.    [OUTPUT COMPILE.FOREACH (LAST :EXPR) (COMPILE.LINE BL BF :EXPR)]
  80. OUTPUT RUN FPUT (WORD "COMPILE. FIRST :EXPR) ~
  81.                 (LIST FIRST BF :EXPR COMPILE.LINE BF BF :EXPR)
  82. END
  83.  
  84. TO COMPILE.TEMPLATE :INPUT :TEMPLATE
  85. IF EMPTYP :TEMPLATE [OUTPUT []]
  86. IF LISTP FIRST :TEMPLATE ~
  87.    [OUTPUT FPUT (COMPILE.TEMPLATE :INPUT FIRST :TEMPLATE) ~
  88.                 (COMPILE.TEMPLATE :INPUT BF :TEMPLATE)]
  89. IF EQUALP FIRST :TEMPLATE "? ~
  90.    [OUTPUT (SE [( FIRST] DOTS :INPUT [)] ~
  91.                (COMPILE.TEMPLATE :INPUT BF :TEMPLATE))]
  92. OUTPUT FPUT (FIRST :TEMPLATE) (COMPILE.TEMPLATE :INPUT BF :TEMPLATE)
  93. END
  94.  
  95. TO COMPILE.TEXT :LINES
  96. IF EMPTYP :LINES [OUTPUT []]
  97. OUTPUT FPUT (COMPILE.LINE FIRST :LINES) (COMPILE.TEXT BF :LINES)
  98. END
  99.  
  100. TO COMPILE1 :PROC
  101. LOCAL "TEXT
  102. IF PROCEDUREP WORD :PROC ".PRECOMPILE [STOP]
  103. MAKE "TEXT TEXT :PROC
  104. DEFINE (WORD :PROC ".PRECOMPILE) :TEXT
  105. DEFINE :PROC FPUT FIRST :TEXT COMPILE.TEXT BF :TEXT
  106. END
  107.  
  108. TO DOTS :NAME
  109. OUTPUT WORD ": :NAME
  110. END
  111.  
  112. TO FROMCLOSE :LIST
  113. OUTPUT FROMCLOSE1 :LIST 0
  114. END
  115.  
  116. TO FROMCLOSE1 :LIST :LEVEL
  117. IF EMPTYP :LIST [OUTPUT []]
  118. IF EQUALP FIRST :LIST "\) ~
  119.    [IFELSE EQUALP :LEVEL 0 ~
  120.            [OUTPUT :LIST] [OUTPUT FROMCLOSE1 BF :LIST :LEVEL-1]]
  121. IF EQUALP FIRST :LIST "\( [OUTPUT FROMCLOSE1 BF :LIST :LEVEL+1]
  122. OUTPUT FROMCLOSE1 BF :LIST :LEVEL
  123. END
  124.  
  125. TO TOCLOSE :LIST
  126. OUTPUT TOCLOSE1 :LIST 0
  127. END
  128.  
  129. TO TOCLOSE1 :LIST :LEVEL
  130. IF EMPTYP :LIST [OUTPUT []]
  131. IF EQUALP FIRST :LIST "\) ~
  132.    [IFELSE EQUALP :LEVEL 0 ~
  133.            [OUTPUT []] [OUTPUT TOCLOSE2 :LIST :LEVEL-1]]
  134. IF EQUALP FIRST :LIST "\( [OUTPUT TOCLOSE2 :LIST :LEVEL+1]
  135. OUTPUT TOCLOSE2 :LIST :LEVEL
  136. END
  137.  
  138. TO TOCLOSE2 :LIST :LEVEL
  139. OUTPUT FPUT FIRST :LIST TOCLOSE1 BF :LIST :LEVEL
  140. END
  141.  
  142.